Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 oF^gr=g#TEXTvgPB2.31+32.TEXT{PB2.33-36.TEXT{ PB2.37.TEXT{ PB2.38.TEXT{ PB2.39.TEXT{ PB2.40.TEXTvg PB2.41.TEXTvgDUMMIr=gD gr=g#D { PB2.19.TEXT{ PB2.20.TEXTvg PB2.21.TEXTvg PB2.22.TEXTvg PB2.23.TEXTvg PB2.24.TEXTvgPB2.25+26.TEXTg PB2.27.TEXTvg PB2.29.TEXT{ PB2.30.@R PB2.6T2.TEXTEXTRX PB2.7.TEXTS{X\ PB2.8.TEXTS{\b PB2.9.TEXTS{bjPB2.10-12.TEXT{jtPB2.13+14.TEXT{t~ PB2.15.TEXT{~ PB2.16.TEXT{PB2.17+28.TEXT{ PB2.18.TEXTTEXTE1S$  PB1.1.TEXT=vg  PB1.2.TEXT=vg PB1.3.TEXTS{  PB1.4.TEXTS{ & PB2.1.TEXT=vg&, PB2.2.TEXT=vg,0 PB2.3+4.TEXTvg06 PB2.5.TEXT=vg6@ PB2.6T1.TEXTvg&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&"auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30   PROGRAM masern;  (* Programmbeispiel 1.1 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) "USES $turtlegra population + kopplung * population * ( 1 - population ) "END; (* von f *) " "PROCEDURE ton(population:real); "BEGIN $IF (abs(population) < 200) THEN note(trunc(150 * population) MOD 47 + 2,20); "END; (* von ton *)  "PROCEDURE eingabe; "BEGIN pplestuff; " "VAR $population,kopplung, $delta_kopplung : real; $zaehler : integer; " "FUNCTION f ( population, kopplung : real ) : real; "BEGIN $IF (abs(population) < 1E-15) THEN &f := population $ELSE &f :=   PROGRAM masernwerte;  (* Programmbeispiel 1.2 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) "USES $aauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 pF^"BEGIN $readln; $textmode; "END; (* von ausgabe *) "  BEGIN (* Hauptprogramm *) "eingabe; "berechne; "ausgabe;  END. (* Hauptprogramm *)     ng := links + bereich * delta_kopplung; (population := 0.3; (FOR zaehler := 1 TO 10 DO *BEGIN ,setze(kopplung,population,links,rechts,oben,unten); ,population := f(population,kopplung); *END; &END; "END; (* von berechne *) " "PROCEDURE ausgabe; $links := 0; rechts := 3; $oben := 1.5; unten := 0; $delta_kopplung := (rechts-links)/xschirm; $initturtle; "END; (* von eingabe *) " "PROCEDURE berechne; " VAR bereich, zaehler : integer; "BEGIN $FOR bereich := 0 TO xschirm DO &BEGIN (kopplu)); $pencolor(white); $move(0) "END; (* von setze *)  "PROCEDURE eingabe; "BEGIN $writeln('Darstellung des Masern-Problems'); writeln; $writeln('Start mit '); $writeln('Wenn das Bild fertig ist, '); $readln; (1 - population) "END; (* von f *) " "PROCEDURE setze ( xkoo, ykoo, links, rechts, oben, unten : real); "BEGIN $pencolor(none); $moveto(round( xschirm * ( xkoo - links ) / ( rechts - links )) ), round( yschirm * ( ykoo - unten ) / ( oben - unten )fics; " "CONST $xschirm = 279; $yschirm = 191; $ "VAR $population,links,rechts, $oben,unten,kopplung, $delta_kopplung : real; " "FUNCTION f ( population, kopplung : real ) : real; "BEGIN $f := population + kopplung * population *$writeln('Auswirkungen der Masern-Formel :'); writeln; $writeln('Jede Folge kann durch Tastendruck beendet werden.'); $writeln('Automatisches Ende, wenn die Werte zu gross werden.'); $writeln; $writeln('Die Formel heisst :'); $writeln $('f(population) = population + kopplung * population * ( 1 - population)'); $writeln; $writeln('Programmende : beide Werte 0'); writeln; $write('Anfangswert population (0..1) > ');readln(population); $write('Parameter kopplung (0..3) > ');readl "END; (* von ausgabe *) "  BEGIN (* Hauptprogramm *) "eingabe; "berechne; "ausgabe;  END. (* Hauptprogramm *)  !  D; (FOR zaehler2 := unsichtbar TO unsichtbar + sichtbar DO *BEGIN ,setze(kopplung,population,links,rechts,oben,unten); ,population := f(population,kopplung); *END; &END; "END; (* von berechne *) " "PROCEDURE ausgabe; "BEGIN $readln; $textmode;"END; (* von eingabe *) " "PROCEDURE berechne; "BEGIN $FOR zaehler1 := 0 TO 279 DO &BEGIN (kopplung := links + zaehler1 * delta_kopplung; (population := 0.3; (FOR zaehler2 := 1 TO unsichtbar DO *BEGIN ,population := f(population,kopplung); *ENpencolor(white); $move(0) "END; (* von setze *)  "PROCEDURE eingabe; "BEGIN $links := 1.8; rechts := 3; $oben := 1.5; unten := 0; $unsichtbar := 50; $sichtbar := 50; $delta_kopplung := (rechts - links) / 279.0; $initturtle; plung * population * (1-population) "END; (* von f *) " "PROCEDURE setze ( xkoo,ykoo,links,rechts,oben,unten : real); "BEGIN $pencolor(none); $moveto(round(279 * (xkoo - links) / (rechts - links)) *,round(191 * (ykoo - unten) / (oben - unten))); $turtlegrafics; " "VAR $population,links,rechts, $oben,unten,kopplung, $delta_kopplung : real; $unsichtbar,sichtbar, $zaehler1, zaehler2 : integer; " "FUNCTION f(population,kopplung:real):real; "BEGIN $f := population + kop   PROGRAM feigenbaum_1;  (* Programmbeispiel 1.3 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) "USES $auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 kF^$UNTIL keypress OR (abs(population) > 30); $read(ch); "UNTIL (population = 0) AND (kopplung = 0);  END. (* Hauptprogramm *)    URE ausgabe; "BEGIN $writeln;writeln('Nach ',zaehler,' Iterationen '); $writeln('hat population den Wert ',population:9:4); $ton(population); "END; (* von ausgabe *) "  BEGIN (* Hauptprogramm *) "REPEAT $eingabe; $REPEAT &berechne; &ausgabe; n(kopplung); $IF (population = 0) AND ( kopplung = 0) THEN exit(PROGRAM); $zaehler := 0; "END; (* von eingabe *) " "PROCEDURE berechne; "BEGIN $population := f(population,kopplung); $zaehler := succ(zaehler); "END; (* von berechne *) " "PROCEDM1 M2 F^ung,population,links,rechts,oben,unten); *population := f(population,kopplung); (UNTIL keypress; (read(ch); &END; "END; (* von berechne *) " "PROCEDURE ausgabe; "BEGIN $readln; $textmode; "END; (* von ausgabe *) "  BEGIN (* Hauptprogramm *)BEGIN $FOR zaehler1 := 0 TO 279 DO &BEGIN (kopplung := links + zaehler1 * delta_kopplung; (zeige_kopplung(kopplung); (population := 0.3; (FOR zaehler2 := 1 TO unsichtbar DO *BEGIN ,population := f(population,kopplung); *END; (REPEAT *setze(koppl$write('unten (>=0) > '); readln(unten); $write('unsichtbar(50) > '); readln(unsichtbar); $write('sichtbar (50) > '); readln(sichtbar); $delta_kopplung := (rechts - links) / 279.0; $initturtle; "END; (* von eingabe *) " "PROCEDURE berechne; "nten := 0; $unsichtbar := 50; $sichtbar := 50; $writeln;writeln; $writeln('Eingabe der Parameter :'); $writeln; $write('links (>=1.8) > '); readln(links); $write('rechts (<=3) > '); readln(rechts); $write('oben (<=1.5) > '); readln(oben); )-4,5); $IF (kopplung<3.27) THEN insert(',',st,2) &ELSE IF (kopplung<32.7) THEN insert(',',st,3); $pencolor(none); moveto(0,0); $wstring(st); "END; (* von zeige_kopplung *) " "PROCEDURE eingabe; "BEGIN $links := 1.8; rechts := 3; $oben := 1.5; u:= abs(kopplung); (* kein Vorzeichen *) $IF (kopplung<3.27) THEN str(trunc(kopplung*10000),st) &ELSE IF (kopplung<32.7) THEN str(trunc(kopplung*1000),st) (ELSE str(trunc(kopplung),st); $st := concat('00000',st); $st := copy(st,length(st$moveto(round(279 * (xkoo - links) / (rechts - links)) *,round(191 * (ykoo - unten) / (oben - unten))); $pencolor(reverse); $move(0) "END; (* von setze *)  "PROCEDURE zeige_kopplung(kopplung : real); $VAR &st : string; "BEGIN $kopplung kopplung : real ) : real; "BEGIN $f := population + kopplung * population * ( 1 - population ) "END; (* von f *) " "PROCEDURE setze ( xkoo,ykoo,links,rechts,oben,unten : real); "BEGIN $pencolor(none); VAR rec : RECORD number: integer END; &pac : PACKED ARRAY [0..0] OF char;  BEGIN "pac[0] := chr(0); "unitwrite(1,pac,1); "unitstatus(1,rec,1); "keypress := (rec.number > 0)  END; (* von keypress, erspart applestuff *) "  FUNCTION f ( population, $turtlegrafics; " "VAR $population,links,rechts, $oben,unten,kopplung, $delta_kopplung : real; $unsichtbar,sichtbar, $zaehler1, zaehler2 : integer; $ch : char; " "  FUNCTION keypress : boolean; " !  PROGRAM feigenbaum_2;  (* Programmbeispiel 1.4 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) # "USES auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM "eingabe; "berechne; "ausgabe;  END. (* Hauptprogramm *)   M1 M2 F^Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 F^ BEGIN (* Hauptprogramm *) "eingabe; "zaehler := 0; "REPEAT $zaehler := zaehler + 1; $berechne; $ausgabe; "UNTIL (zaehler >= 20) OR (abs(population) >= 30);  END. (* Hauptprogramm *)    := population + kopplung * population * ( 1 - population ) "END; (* von berechne *) " "PROCEDURE ausgabe; "BEGIN $writeln;writeln('Nach ',zaehler,' Iterationen '); $writeln('hat population den Wert ',population:9:4); "END; (* von ausgabe *) " population (0..1) > '); $readln(population); $write('Parameter kopplung (0..3) > '); $readln(kopplung); "END; (* von eingabe *) " "PROCEDURE berechne; "BEGIN $IF (abs(population) < 1E-15) THEN &population := population $ELSE &populationpulation,kopplung : real; $zaehler : integer;  "PROCEDURE eingabe; "BEGIN $writeln; $writeln('Die Formel heisst :'); $writeln $('f(population) = population + kopplung * population * ( 1 - population)'); $writeln; $write('Anfangswert    PROGRAM masernwerte;  (* Programmbeispiel 2.1 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) "VAR $poauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30    PROGRAM masernwerte;  (* Programmbeispiel 2.2 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) "VAR $poitturtle; #pencolor(white); #REPEAT %x:= 180 + random MOD 60; %y:= 1 + random MOD 120; %moveto(x,y); #UNTIL keypress;  END.   PROGRAM testturnto; "USES $APPLESTUFF,TURTLEGRAPHICS; "VAR $ winkel,laenge : integer;  BEGIN #initturtle; #RESTUFF,TURTLEGRAPHICS; "VAR $...  BEGIN "initturtle; "... "textmode; "... "grafmode; "... "REPEAT "UNTIL keypress;  END.   PROGRAM testmoveto; "USES $APPLESTUFF,TURTLEGRAPHICS; "VAR $x, y : integer;  BEGIN #in   (* Programmbeispiele 2.3 und 2.4 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) PROGRAM demografik; "USES $APPLEauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM N^ (* Hauptprogramm *)    $writeln('hat population den Wert ',population:9:4); "END; (* von ausgabe *) "  BEGIN (* Hauptprogramm *) "eingabe; "zaehler := 0; "REPEAT $zaehler := zaehler + 1; $berechne; $ausgabe; "UNTIL (zaehler >= 20) OR (abs(population) >= 30);  END. END; (* von eingabe *) " "PROCEDURE berechne; "BEGIN $population := f(population,kopplung); "END; (* von berechne *) " "PROCEDURE ausgabe; "BEGIN $writeln;writeln('Nach ',zaehler,' Iterationen '); e Formel heisst :'); $writeln $('f(population) = population + kopplung * population * ( 1 - population)'); $writeln; $write('Anfangswert population (0..1) > '); $readln(population); $write('Parameter kopplung (0..3) > '); $readln(kopplung); "pulation,kopplung : real; $zaehler : integer;  "FUNCTION f (p, k : real) : real; "BEGIN $IF (abs(p) < 1.0E-15) THEN &f := p $ELSE &f := p + k * p * ( 1 - p ); "END; (* von f *) " "PROCEDURE eingabe; "BEGIN $writeln; $writeln('DiPEAT # pencolor(none); %moveto(180,80); %pencolor(white); # winkel := 0 + random MOD 360; %laenge := 10 + random MOD 40; # turnto(winkel); %move(laenge); #UNTIL keypress;  END.  O^Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM N^zaehl2] = '1'; "END; "  BEGIN "initturtle; "eingabe; "drawblock(source,4,0,0,32,14,140,90,10);  readln; "FOR zaehl1 := 0 TO 90 DO $drawblock(source,4,0,0,32,14,3*zaehl1,2*zaehl1,10);  END. $quelle[12] := '________________________________'; $quelle[13] := '________________________________'; $quelle[14] := '________________________________'; $FOR zaehl1 := 1 TO 14 DO &FOR zaehl2 := 1 TO 32 DO (source[15 - zaehl1,zaehl2] := quelle[zaehl1,___1________________1_1___'; $quelle[ 8] := '__________1______________1______'; $quelle[ 9] := '__________111111111111111_______'; $quelle[10] := '_________11_11_______11_11______'; $quelle[11] := '________11___11_____11___11_____'; _11_______11__________'; $quelle[ 3] := '____1_____11__________1_________'; $quelle[ 4] := '_____1____1____________1________'; $quelle[ 5] := '______1__11_____________1___1___'; $quelle[ 6] := '_______111_____________1_111____'; $quelle[ 7] := '______ES turtlegrafics; " "VAR $zaehl1, zaehl2 : integer; $source : PACKED ARRAY [1..14,1..32] OF boolean; $quelle : ARRAY [1..14] OF string[32]; $ "PROCEDURE eingabe; "BEGIN $quelle[ 1] := '___11________1111111____________'; $quelle[ 2] := '___1______   (* Programmbeispiel 2.5 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *)  PROGRAM demo_drawblock;  "USauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30    (* Programmbeispiel 2.6, Teil 1 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *)  PROGRAM Alles_zusammen; %USES ufruf hin *) ' 'REPEAT 'UNTIL KEYPRESS;  END. >'); readln(grad,seite); 'write('startx,starty >'); readln(startx,starty ); ' $(* Initialisierung des Grafikschirms *) 'initturtle; 'pencolor(none); 'moveto(startx,starty); 'pencolor(white); $(* Hier kommt der entsprechende Prozedura.move(-zufall(seite,seite+5)); .turn(-winkel); *END; (END; (  BEGIN $(* Falls noch andere Groesen benoetigt werden *) $(* muessen "write" und "read"- Anweisungen *) $(* entsprechend ergaenzt werden *) 'write('grad,seite BEGIN *IF grad > 0 THEN *BEGIN .turn(-winkel); .move(2*zufall(seite,seite+5)); .zufallzweig(grad-1,seite,winkel); .move(-2*zufall(seite,seite+5)); .turn(2*winkel); .move(zufall(seite,seite+5)); .zufallzweig(grad-1,seite,winkel); ; -move(seite); -zweig(grad-1,seite,winkel); -move(-seite); -turn(-winkel); +END; (END; ( (FUNCTION zufall(a,b : integer) : integer; (BEGIN *zufall:= a + random mod (b-a +1); (END; ( ( (PROCEDURE zufallzweig (grad,seite,winkel : integer); ((grad - 1,trunc(seite/2)); -move(-seite); -turn(-45); )END; 'END; & 'PROCEDURE zweig (grad,seite,winkel : integer); 'BEGIN *IF grad > 0 THEN *BEGIN -turn(-winkel); -move(2*seite); -zweig(grad-1,seite,winkel); -move(-2*seite); -turn(2*winkel)-ckurve (grad - 1,trunc(seite)); -turn (-90); )END; 'END; & 'PROCEDURE tree (grad,seite : integer); 'BEGIN )IF grad > 0 THEN )BEGIN -turn(-45); -move(seite); -tree (grad - 1,trunc(seite/2)); -move(- seite); -turn ( 90); -move(seite); -tree ite); (turn(120); (koch(grad,seite); (turn(120); (koch(grad,seite); (turn(120); &END; & &PROCEDURE ckurve (grad,seite : integer); &BEGIN )IF grad = 0 THEN +move(seite) )ELSE )BEGIN -ckurve (grad - 1,trunc(seite)); -turn ( 90); d - 1,trunc(seite/3)); ,turn ( 90); ,rechteckkoch(grad - 1,trunc(seite/3)); ,turn ( 90); ,rechteckkoch(grad - 1,trunc(seite/3)); ,turn (-90); ,rechteckkoch(grad - 1,trunc(seite/3)); ,END; &END; & & &PROCEDURE schneeflocke; &BEGIN (koch(grad,seunc(seite/3)); ,turn (-60); ,koch(grad - 1,trunc(seite/3)); (END; &END; & &PROCEDURE rechteckkoch(grad,seite : integer); &BEGIN (IF grad = 0 THEN *move(seite) (ELSE (BEGIN ,rechteckkoch(grad - 1,trunc(seite/3)); ,turn (-90); ,rechteckkoch(gra+dragon(grad+1,trunc(seite)); )END; %END; ) %PROCEDURE koch(grad,seite : integer); %BEGIN (IF grad = 0 THEN *move(seite) (ELSE (BEGIN ,koch(grad - 1,trunc(seite/3)); ,turn (-60); ,koch(grad - 1,trunc(seite/3)); ,turn (120); ,koch(grad - 1,trrad,seite : integer); %BEGIN 'IF grad = 0 THEN )move(seite) 'ELSE )IF grad > 0 THEN )BEGIN +dragon(grad-1,trunc(seite)); +turn(90); +dragon(-(grad-1),trunc(seite)); )END )ELSE )BEGIN +dragon(-(grad+1),trunc(seite)); +turn(270); g); +move(seite); +turn(richtung*90); +hilbert(grad-1,seite,richtung); +move(seite); +hilbert(grad-1,seite,richtung); +turn(richtung*90); +move(seite); +hilbert(grad-1,seite,-richtung); +turn(-richtung*90); )END; %END; & & %PROCEDURE dragon(g'applestuff,turtlegraphics; (* nur bei APPLE ][ *) %VAR (grad,seite,richtung,winkel,startx,starty : integer; % %PROCEDURE hilbert(grad,seite,richtung : integer); %BEGIN )IF grad > 0 THEN )BEGIN +turn(-richtung*90); +hilbert(grad-1,seite,-richtunO^yko,xko+anf]); *werte[xko,max-xko-yko] := zuf(werte[xko-anf,max-xko-yko+anf], Bwerte[xko+anf,max-xko-yko-anf]); *xko := xko + schrittweite; (UNTIL xko > (max - yko); (yko := yko + schrittweite; &UNTIL yko >= max; $END; "  BEGIN $writeln; writelmaxi THEN maxi := zw; " zuf := zw; "END; " "PROCEDURE fuellen; $ $PROCEDURE fuell; $BEGIN &yko := 0; &REPEAT (xko := anf; (REPEAT *werte[xko,yko] := zuf(werte[xko-anf,yko],werte[xko+anf,yko]); *werte[yko,xko] := zuf(werte[yko,xko-anf],werte[$schrittweite := werte[2,max+1]; $anf := werte[3,max+1]; "END; " "FUNCTION zuf(a,b : integer) : integer; "{ FUNCTION mit Seiteneffekt ! } "BEGIN $zw := (a + b) DIV 2 + random MOD schrittweite - anf; " IF zw < mini THEN mini := zw; " IF zw > ame = '' THEN exit(PROGRAM); &(*$I- *) reset(f,filename); io:=ioresult; /close(f,lock); (*$I+ *) $UNTIL io = 0; $reset(f,filename); io:=blockread(f,werte,17); $close(f,lock); $mini := werte[0,max+1]; $maxi := werte[1,max+1]; ,filename)=0 THEN &filename := concat(filename,'.DATA'); $close(f); rewrite(f,filename); $io:=blockwrite(f,werte,17); close(f,lock); "END; " "PROCEDURE dslesen; "BEGIN $REPEAT &writeln; write(' Name des Datensatzes '); readln(filename); &IF filenlock); "END; (* von abspeichern *) " "PROCEDURE dsspeichern; "BEGIN $textmode; page(output); writeln; $writeln(' Datensatz abspeichern auf Diskette '); writeln; writeln; writeln; $write('unter welchem Namen ? '); readln(filename); $IF pos('.DATA'$write('Unter welchem Namen ? '); readln(filename); $IF pos('.FOTO',filename)=0 THEN &filename := concat(filename,'.FOTO'); $grafmode; $inout.adresse := page1; close(f); $rewrite(f,filename); $io:=blockwrite(f,inout.zeiger^,16); $textmode; close(f, END; $filename : string; $f : file; * $ $ $ " "PROCEDURE abspeichern; "BEGIN $textmode; page(output); writeln; writeln; $writeln(' Abspeichern auf Diskette '); $writeln; writeln; writeln; : char; $dreieck : boolean; $werte : ARRAY[0..max,0..max2] OF integer; $faktor : real; $inout : RECORD CASE boolean OF 2 true : (adresse:integer); 2 false: (zeiger:^integer); 0 "USES $turtlegrafics, applestuff; " "CONST $max = 64; max2 = 66; $page1 = 8192; page2 = 16384; " "VAR $zw, schritt, $lin, dx, dy, $mini, maxi, xsp, $xko, yko, io, $oben, unten, $anf, schrittweite : integer; $ch (*$S+ *)PROGRAM fractale_Landschaften;  (* Programmbeispiel 2.6 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM n('Bitte 90 Sekunden warten,'); $writeln('ein Datensatz wird erzeugt.'); $ $mini := 0; maxi := 0; $schrittweite := max; anf := schrittweite DIV 2; $REPEAT &fuell; &schrittweite := anf; &anf := anf DIV 2; $UNTIL anf = schrittweite; " werte[0,max+1] := mini; $werte[1,max+1] := maxi; $werte[2,max+1] := schrittweite ; $werte[3,max+1] := anf ; "END; " "PROCEDURE eingabe; "BEGIN $randomize; $fillchar(werte,sizeof(werte),chr(0)); $writeln; writeln; $writeln('Dies Programm zeic&writeln('Maximalwert : ',maxi:6); &writeln('Minimalwert : ',mini:6); &write('Hoehenlinie > '); readln(lin); &write('Schrittweite ( 1 oder 2 )> '); readln(schritt); &schritt := 1 + (schritt-1) MOD 2; &write('oben (ca. 200) > 'h IN ['j','J','y','Y']) THEN abspeichern; &writeln; write('Datensatz speichern '); read(ch); &IF (ch IN ['j','J','y','Y']) THEN dsspeichern;writeln; writeln; &write('Hoehenfaktor (0 to Quit) > ');readln(faktor); $ IF (faktor = 0) THEN exit(PROGRAM); $xko := 0; $REPEAT &lang_dreieck; &IF NOT dreieck THEN lang_viereck; &xko := xko + schritt; $UNTIL xko = max; $readln; "END; "  PROCEDURE nochmal; $BEGIN &textmode; writeln;writeln; writeln; &write('Bild speichern '); read(ch); &IF (ce[max-yko,max-xko] > lin) THEN pencolor(white) else pencolor(none); (yko := yko + schritt; &END; $END; & $ "BEGIN $initturtle; $yko := 0; $REPEAT &quer_dreieck; &IF NOT dreieck THEN quer_viereck; &yko := yko + schritt; $UNTIL yko > max; pencolor(white) else pencolor(none); (yko := yko + schritt; &UNTIL yko > max - xko; $END; $ $PROCEDURE lang_viereck; $BEGIN &WHILE (yko <= max) DO BEGIN (moveto(xsp + dx*xko+dy*yko, 0oben- dy*yko + round(faktor*werte[max-yko,max-xko])); (IF (wertround(faktor * lin)); &REPEAT (IF (werte[xko,succ(yko)] > lin) THEN moveto(xsp + dx*xko+dy*yko, 0oben - dy*yko + round(faktor * werte[xko,yko])) *ELSE moveto(xsp + dx*xko+dy*yko, 0oben - dy*yko + round(faktor * lin)); (IF (werte[xko,yko] > lin) THEN $PROCEDURE lang_dreieck; $BEGIN &yko := 0; &pencolor(none); &IF werte[xko,yko] > lin THEN BEGIN (moveto(xsp + dx*xko+dy*yko,oben - dy*yko + round(faktor * werte[xko,yko])); (pencolor(white); &END ELSE &moveto(xsp + dx*xko+dy*yko,oben - dy*yko + faktor * werte[max-yko,max-xko])); (END ELSE BEGIN *pencolor(none); ( moveto(xsp + dx*xko+dy*yko,oben - dy*yko + round(faktor * lin)); *pencolor(white); Move(0); pencolor(none); (END; (xko := xko + schritt; &END; $END; & ne); (END; (xko := xko + schritt; &UNTIL xko > max - yko; $END; & $PROCEDURE quer_viereck; $BEGIN &WHILE (xko <= max) DO BEGIN (IF (werte[max-yko,max-xko] > lin) THEN BEGIN *pencolor(white); *moveto(xsp + dx*xko+dy*yko, 1oben - dy*yko + round( THEN BEGIN *pencolor(white); *moveto(xsp + dx*xko+dy*yko, 1oben - dy*yko + round(faktor * werte[xko,yko])); (END ELSE BEGIN *pencolor(none); ( moveto(xsp + dx*xko+dy*yko,oben - dy*yko + round(faktor * lin)); *pencolor(white); Move(0); pencolor(no&pencolor(none); &IF werte[xko,yko] > lin THEN &moveto(xsp + dx*xko+dy*yko,oben - dy*yko + round(faktor * werte[xko,yko])) &ELSE &moveto(xsp + dx*xko+dy*yko,oben - dy*yko + round(faktor * lin)); &pencolor(white); &REPEAT (IF (werte[xko,yko] > lin)$writeln('Der Datensatz wird N(eu erzeugt'); $write('oder von D(iskette gelesen '); read(ch); $IF (ch = 'D') OR (ch ='d') THEN dslesen " ELSE fuellen; "END;  "PROCEDURE zeichnen; $ $PROCEDURE quer_dreieck; $BEGIN &xko := 0; ; $writeln('mit denen ebenso verfahren wird.'); $writeln('Insgesamt erfolgen 6 Iterationen.'); $writeln; writeln('Durch einen Faktor laesst sich die '); $writeln('''Steilheit'' der Landschaft und andere'); $writeln('Parameter einstellen.'); writeln; hnet fractale '); $writeln('Landschaften.'); $writeln('Begonnen wird mit einem Dreieck, dessen'); $writeln('Seitenmittelpunkte zufaellig vertikal'); $writeln('verschoben werden. Verbindet man diese'); $writeln('Punkte, entstehen 4 kleinere Dreiecke,')); readln(oben); &write('unten (ca. 0 ) > '); readln(unten); &write('Verschiebung des Bildes > '); readln(xsp ); &dy := (oben-unten) DIV max;dx := dy + dy; &write('Als D(reieck zeichnen oder als V(iereck ? '); read(ch); writeln; &dreieck := (ch IN ['d','D']); $END; $  BEGIN  eingabe; "REPEAT $nochmal; $zeichnen; "UNTIL false;  END. ) $   BEGIN (* Hauptprogramm, Version 2 *) "sammeleingabe; "FOR zaehl1 := 1 TO bildzahl DO $BEGIN &eingabe; &berechnung; &ausgabe; $END;  END. (* Hauptprogramm, Version 2 *)   "PROCEDURE berechnung; "BEGIN $writeln('Hallo, Berechnung'); "END; " "PROCEDURE ausgabe; "BEGIN $writeln('Hallo, Ausgabe'); "END;   BEGIN (* Hauptprogramm, Version 1 *) "eingabe; "berechne; "ausgabe;  END. (* Hauptprogramm, Version 1 *$unten,oben : real; $filename : string[20]; $satz : ARRAY[1..34] OF tdaten; "  (* gegebenenfalls muessen weitere Variablen ergaenzt werden *)  "PROCEDURE eingabe; "BEGIN $writeln('Hallo, Eingabe'); "END;  1,zaehl2, $zaehl3,zaehl4 : integer; $ch : char; $fertig : boolean; $p,k,x,y, $deltax, deltay, $absqu, $c_imaginaer,c_reell, $xhoch2,yhoch2, $population, $kopplung, $delta_kopplung, $links,rechts, ks,rechts, .oben,unten : real; .unsichtbar, .sichtbar : integer; .name : string[20]; ,END; $(* gegebenenfalls muessen weitere Typen ergaenzt werden *)  "VAR $bildzahl, $grenze1,anzahl, $unsichtbar,sichtbar, $zaehl *) "USES $turtlegrafics, $transcend; $(* gegebenenfalls muessen weitere Bibliotheken ergaenzt werden *)  "CONST $xpunkte = 279; $ypunkte = 191; $(* gegebenenfalls muessen weitere Konstanten ergaenzt werden *)  "TYPE $tdaten = RECORD .lin   PROGRAM irgendein_sinnvoller_Name; "  (* Programmbeispiel 2.7 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M2 M1 M2 H^M2 M1 M2 vvvH^ite('oben (<=1.5) > '); readln(oben); $writeln; $write('unsichtbar(50) > '); readln(unsichtbar); $writeln; $write('sichtbar (50) > '); readln(sichtbar); $delta_kopplung := (rechts - links) / 279.0; " initturtle; "END; "(* Fuer andere Programme *) " "BEGIN $writeln; writeln; $writeln('Eingabe der Parameter :'); $writeln; $write('links (>=1.8) > '); readln(links); $writeln; $write('rechts (<=3) > '); readln(rechts); $writeln; $write('unten (>=0) > '); readln(unten); $writeln; $wr "PROCEDURE eingabe; (* Version 2 *) "  (* Programmbeispiel 2.9 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M2 M1 M2 H^ks := -1.0; #rechts := 2.5; #unten := -1.2; #oben := 1.2; #grenze := 100; #anzahl := 20; *) # # *) " "BEGIN $links := 1.8; $rechts := 3.0; $oben := 1.5; $unten := 0.0; $unsichtbar := 50; $sichtbar := 50; $delta_kopplung := (rechts - links) / 279.0; " initturtle; "END;  (* Fuer Apfelmaennchen : #lin  "PROCEDURE eingabe; (* Version 1 *) "  (* Programmbeispiel 2.8 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM Variablen und Vorschlaege aendern : $z.B. Apfelmaennchen : $ $write('links (>= -1) > '); readln(links); $writeln; $write('rechts (<=3) > '); readln(rechts); $writeln; $write('unten (>=-1.2) > '); readln(unten); $writeln; $write('oben (<=1.2) > '); readln(oben); $writeln; $write('Iterationen(20)> '); readln(anzahl); $writeln; $grenze1 := 100; *) " " be; (* Version 2.1 *) "  (* Programmbeispiel 2.12 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " $BEGIN $wr(BEGIN *write(chr(7)); (* Bell *) *writeln('Bitte im Intervall ',untergrenze,' bis ', *obergrenze,' bleiben !'); *write('Neueingabe > '); (END; #UNTIL (zahl >= untergrenze) AND (zahl <= obergrenze); !END; #  " "PROCEDURE einga (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " $BEGIN $REPEAT &realreadln(zahl); &IF (zahl < untergrenze) OR (zahl > obergrenze) THEN chstabe = ',') 1THEN komma := true; &END; $zahl := zahl * faktor; "END; " " "PROCEDURE liesreal(VAR zahl : real; untergrenze,obergrenze : real);   (* Programmbeispiel 2.11 aus *) 1.0; $FOR zaehler := 1 TO length(wort) DO &BEGIN (buchstabe := wort[zaehler]; (IF (buchstabe in ['0'..'9']) *THEN ,BEGIN .zahl := 10.0*zahl + ord(buchstabe) - ord('0') .IF komma THEN faktor := faktor * 0.1; ,END *ELSE IF (buchstabe = '.') OR (bu *) " $VAR &wort : string; &buchstabe : char; &zaehler : integer; &faktor : real; &komma : boolean; & "BEGIN $faktor := 1.0; $zahl := 0.0; $komma := false; $ $readln(wort); $ $IF (wort[1] = '-') THEN faktor := -" "PROCEDURE realreadln(VAR zahl : real);   (* Programmbeispiel 2.10 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M2 M1 M2 CH^iteln;writeln; $writeln('Eingabe der Parameter :'); $writeln; $write('links (>=1.8) > '); liesreal(links,0.0,3.0); $writeln; $write('rechts (<=3) > '); liesreal(rechts,0.0,3.0); $writeln; $write('oben (<=1.5) > '); liesreal(oben,0.0,2.0); $writeln; $write('unten (>=0) > '); liesreal(unten,0.0,2.0); $writeln; $write('unsichtbar(50) > '); readln(unsichtbar); $writeln; $write('sichtbar (50) > '); readln(sichtbar); $delta_k := (rechts-links)/279.0; " initturtle; "END; " (* Fuer aingabe der Parameter '); *writeln('fuer das ',zaehl1,'. Bild :'); *writeln; *write('links (>=1.8) > '); liesreal(links,0.0,3.0); *writeln; *write('rechts (<=3) > '); liesreal(rechts,0.0,3.0); *writeln; *write('oben (<=1.5) > '); liesreal(oben,0$writeln('Platz ist ? '); $writeln('Sonst neue Diskette(n) einlegen und .'); $read(ch); writeln; $IF NOT(ch IN ['j','J','y','Y']) &THEN exit(PROGRAM); $FOR zaehl1 := 1 TO bildzahl DO &WITH satz[zaehl1] DO (BEGIN *writeln;writeln; *writeln('E$writeln('Wieviel Zeichnungen nacheinander ? '); $write('maximal 34 > '); readln(bildzahl); $IF bildzahl > 34 THEN bildzahl := 34; $writeln; $write('Ist sicher, dass auf #5: '); $IF bildzahl>17 THEN write('und #4: '); $writeln('noch genuegend'); tz[zaehl1].sichtbar; $unsichtbar := satz[zaehl1].unsichtbar; $filename := satz[zaehl1].name; $delta_k := (rechts - links)/279.0; $initturtle; "END;  "PROCEDURE sammeleingabe; (* Version 1 *) "BEGIN PROCEDURE eingabe; (* Version 4, passend zur Sammeleingabe *) "BEGIN $links := satz[zaehl1].links; $rechts := satz[zaehl1].rechts; $unten := satz[zaehl1].unten; $oben := satz[zaehl1].oben; $sichtbar := sas,rechts, .oben,unten : real; .unsichtbar, .sichtbar : integer; .name : string[20]; ,END;  "VAR $bildzahl : integer; $filename : string[20]; $satz : ARRAY[1..34] OF tdaten; " ""   (* Programmbeispiele 2.13 und 2.14 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " "TYPE $tdaten = RECORD .linkauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M2 M1 M2 "H^en,-1.5,1.5); $writeln; $write('oben (<=1.2) > '); liesreal(oben,-1.5,1.5); $writeln; $write('Iterationen(20)> '); readln(anzahl); $writeln; $grenze1 := 100; *) " " ndere Programme Variablen und Vorschlaege aendern : $z.B. Apfelmaennchen : $ $write('links (>= -1) > '); liesreal(links,-1.0,3.0); $writeln; $write('rechts (<=3) > '); liesreal(rechts,-1.0,3.0); $writeln; $write('unten (>=-1.2) > '); liesreal(unt.0,2.0); *writeln; *write('unten (>=0) > '); liesreal(unten,0.0,2.0); *writeln; *write('unsichtbar(50) > '); readln(unsichtbar); *writeln; *write('sichtbar (50) > '); readln(sichtbar); ( write('Unter welchem Namen abspeichern ?'); *write('(max. 7 Buchstaben > '); *IF zaehl1 < 18 ,THEN write('#5:') ,ELSE write('#4:'); *readln(filename); *IF length(filename) > 7 ,THEN filename := copy(filename,1,7); *IF zaehl1 < 18 ,THEN name := concat('#5:',filename,'.FOTO') ,ELSE name := cher, dass auf #5: '); &IF bildzahl>17 THEN write('und #4: '); &writeln('noch genuegend'); &writeln('Platz ist ? '); &writeln('Sonst neue Diskette(n) einlegen und .'); &read(ch); writeln; &IF NOT(ch IN ['j','J','y','Y']) (THEN exit(PROGRAM); & *) " $ $PROCEDURE erstes_bild; $BEGIN &stelle := 'A'; &writeln(' Z O O M '); &writeln('Wieviel Zeichnungen nacheinander ? '); &write('maximal 34 > '); readln(bildzahl); &IF bildzahl > 34 THEN bildzahl := 34; &writeln; &write('Ist si "PROCEDURE sammeleingabe; (* Version 2 *)  (* Programmbeispiel 2.15 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M2 M1 M2 H^$write('unten (>=-1.2) > '); liesreal(unten,-1.5,1.5); $writeln; $write('oben (<=1.2) > '); liesreal(oben,-1.5,1.5); $writeln; $write('Iterationen(20)> '); readln(anzahl); $writeln; $grenze1 := 100; *) " " [zaehl1].grenze1; $anzahl := satz[zaehl1].anzahl; $filename := satz[zaehl1].name; $initturtle; "END;  $write('links (>= -1) > '); liesreal(links,-1.0,3.0); $writeln; $write('rechts (<=3) > '); liesreal(rechts,-1.0,3.0); $writeln; .name : string[20]; ,END;  "PROCEDURE eingabe; "BEGIN $links := satz[zaehl1].links; $rechts := satz[zaehl1].rechts; $unten := satz[zaehl1].unten; $oben := satz[zaehl1].oben; $grenze1 := satzconcat('#4:',filename,'.FOTO'); (END;  END;  " " (* Fuer andere Programme Variablen und Vorschlaege aendern : $z.B. Apfelmaennchen : $ $TYPE $tdaten = RECORD .links,rechts, .unten,oben : real; .grenze1, .anzahl : integer;WITH satz[1] DO (BEGIN *writeln;writeln; *writeln('Eingabe der Parameter '); *writeln('fuer das erste Bild :'); *writeln; *write('links (>=1.8) > '); liesreal(links,0.0,3.0); *writeln; *write('rechts (<=3) > '); liesreal(rechts,0.0,3.0); *writeln; *write('oben (<=1.5) > '); liesreal(oben,0.0,2.0); *writeln; *write('unten (>=0) > '); liesreal(unten,0.0,2.0); *writeln; *write('unsichtbar(50) > '); readln(unsichtbar); *writeln; *write('sichtbar (50) > '); readln(sichtbar); *wriDies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 M3 M4 H^tes_bild; $alle_anderen; "END; (* von sammeleingabe *)  ,IF zaehl1 < 18 .THEN name := concat('#5:',filename,stelle,'.FOTO') .ELSE name := concat('#4:',filename,stelle,'.FOTO'); ,writeln(links:7:4,rechts:7:4,oben:7:4,unten:7:4,name); *END; $END; (* von alle_anderen *) & "BEGIN $erstes_bild; $letz); ,sichtbar := satz[1].sichtbar + trunc(zaehl1/bildzahl* =(satz[bildzahl].sichtbar-satz[1].sichtbar)); ,unsichtbar := satz[1].unsichtbar + trunc(zaehl1/bildzahl* 9(satz[bildzahl].unsichtbar-satz[1].unsichtbar)); ,stelle[1] := chr(ord('A')+zaehl1);,links := zentx + (satz[bildzahl].links - zentx)* ;exp((bildzahl-zaehl1)*lnfx); ,oben := zenty + (satz[bildzahl].oben - zenty)* ;exp((bildzahl-zaehl1)*lnfy); ,unten := zenty + (satz[bildzahl].unten- zenty)* ;exp((bildzahl-zaehl1)*lnfy* von letztes_bild *) " $PROCEDURE alle_anderen; $BEGIN &FOR zaehl1 := 2 TO bildzahl DO (WITH satz[zaehl1] DO *BEGIN ,rechts := zentx + (satz[bildzahl].rechts - zentx)* ;exp((bildzahl-zaehl1)*lnfx); .unten*satz[bildzahl].oben - 0satz[bildzahl].unten*satz[1].oben)/ /(satz[1].unten+satz[bildzahl].oben- 0satz[bildzahl].unten-satz[1].oben); &fakty := (satz[1].oben - zenty)/(satz[bildzahl].oben - zenty); &lnfy := (ln(fakty))/bildzahl; $END; (ahl].rechts - 0satz[bildzahl].links*satz[1].rechts)/ /(satz[1].links+satz[bildzahl].rechts- 0satz[bildzahl].links-satz[1].rechts); &faktx := (satz[1].rechts - zentx)/(satz[bildzahl].rechts - zentx); &lnfx := (ln(faktx))/bildzahl; &zenty := (satz[1]*write('sichtbar (200) > '); readln(sichtbar); *stelle[1] := chr(ord('A')+bildzahl); *IF bildzahl < 18 ,THEN name := concat('#5:',filename,stelle,'.FOTO') ,ELSE name := concat('#4:',filename,stelle,'.FOTO'); (END; &zentx := (satz[1].links*satz[bildz); liesreal(rechts,0.0,3.0); *writeln; *write('oben (<=1.5) > '); liesreal(oben,0.0,2.0); *writeln; *write('unten (>=0) > '); liesreal(unten,0.0,2.0); *writeln; *write('unsichtbar(50) > '); readln(unsichtbar); *writeln; URE letztes_bild; $BEGIN &WITH satz[bildzahl] DO (BEGIN *writeln;writeln; *writeln('Eingabe der Parameter '); *writeln('fuer das letzte Bild :'); *writeln; *write('links (>=1.8) > '); liesreal(links,0.0,3.0); *writeln; *write('rechts (<=3) > 'te('Unter welchen Namen abspeichern ?'); *write('(max. 5 Buchstaben > '); *readln(filename); *IF length(filename) > 5 ,THEN filename := copy(filename,1,5); *name := concat('#5:',filename,'A.FOTO'); (END; $END; (* von erstes_bild *) $ $PROCEDauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30  PROGRAM reinigen; "  (* Programmbeispiel 2.16 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) VAR $lesefile,Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 F^END; (* von setze *)    ncolor(white); "move(0)  END; (* von setze *)   (* Im allgemeinen kann man IF..THEN streichen *)    PROCEDURE setze ( xkoo,ykoo : integer);  (* Integer-Version *)  BEGIN "pencolor(none); "moveto(xkoo,ykoo); "pencolor(white); "move(0)  1986 *) " BEGIN "pencolor(none); "IF (xkoo >= links) AND (xkoo <= rechts) %AND (ykoo >= unten) AND (ykoo <= oben ) THEN 'moveto(round(279.0 * (xkoo -links) / (rechts -links)) .,round(191.0 * (ykoo -unten) / (oben -unten))); "pePROCEDURE setze ( xkoo,ykoo,links,rechts,unten,oben : real);    (* Programmbeispiel 2.17 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbadenauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 F^ile,name); "WHILE NOT eof(lesefile) DO $BEGIN &readln(lesefile,zeile); &writeln(schreibfile,zeile); $END; "close(schreibfile,lock);  END.   $schreibfile : text; $zeile,name : string;  BEGIN "writeln('Dies Programm macht ein EXEC-File'); "writeln('aus einem TEXT-File.'); "write('Name des Files : '); readln(name); "name := concat(name,'.TEXT'); "reset(lesefile,name); "rewrite(schreibfauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30    PROCEDURE ziehe ( xkoo,ykoo,links,rechts,unten,oben : real; 2farbe : screencolor);   (* Programmbeispiel 2.18 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 F^st,length(st) - 4,5); "IF (k < 3.27) $THEN insert(',',st,2) $ELSE IF (k < 32.7) +THEN insert(',',st,3); "pencolor(none); "moveto(0,0); "chartype(10); "wstring(st);  END;    " VAR $st : string;  BEGIN "k := abs(k); (* kein Vorzeichen *) "IF (k < 3.27) $THEN str(trunc(k * 10000),st) $ELSE IF (k < 32.7) +THEN str(trunc(k * 1000),st) +ELSE str(trunc(k),st); "st := concat('00000',st); "st := copy(   PROCEDURE zeige_k(k : real); "  (* Programmbeispiel 2.19 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 F^  (* Braunschweig/Wiesbaden 1986 *) " BEGIN "pencolor(farbe); "moveto(round(279 * (xkoo - links) / (rechts - links)) (,round(191 * (ykoo - unten) / (oben - unten)));  END; (* von ziehe *)       auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30  (* Programmbeispiel 2.20 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " FUNCTION f(p,k : real) : real;  (* Gr END; 8   BEGIN "f := k * (1.0 - 2.0 * abs(p - 0.5));  END; "   FUNCTION f(p,k : real) : real;  (* Version 8 : mit "Vorfahren" *)  BEGIN "p_alt := p_uralt; "p_uralt := p; "f := p + 0.5 * k * (3.0 * p * (1.0 - p) - p_alt * (1.0 - p_alt)); : mit Sinus und Cosinus *)  BEGIN "f := k * sin(p) * cos(p);  END; "   FUNCTION f(p,k : real) : real;  (* Version 6 : Wurzel *)  BEGIN "f := k * sqrt(p * (1.0 - p));  END; "   FUNCTION f(p,k : real) : real;  (* Version 7 : "Saegezahn" *) (* Version 3 : Quadratisch *)  BEGIN "f := k * p * p * (1.0 - p);  END; "   FUNCTION f(p,k : real) : real;  (* Version 4 : nochmal Quadratisch *)  BEGIN "f := k * p * (1.0 - p * p);  END; "   FUNCTION f(p,k : real) : real;  (* Version 5    (* Programmbeispiel 2.21 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " FUNCTION f(p,k : real) : real; auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 F^undversion *)  BEGIN "f := p + k * p * (1.0 - p);  END; "   FUNCTION f(p,k : real) : real;  (* Version 2 : Zuwachs *)  BEGIN "p := k * p * (1.0 - p);  IF (abs(p) < 1.0E-15) THEN p := 0.0; "f := p;  END; "   M1 M2 RRF^Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 F^(population := f(population,kopplung); &UNTIL keypress; &read(ch); $END;  END;     tion := 0.3; &(* Wenn es n|tig sein sollte : *) &(* p_alt := 0.3; p_uralt := 0.3; *) &FOR zaehl2 := 1 TO unsichtbar DO (BEGIN *population := f(population,kopplung); (END; &REPEAT (setze(kopplung,population,links,rechts,unten,oben); plung); (END; $END;  END; (* von berechne *)    PROCEDURE berechne;  (* Version 2 mit REPEAT...UNTIL keypress - Schleife *)  BEGIN "FOR zaehl1 := 0 TO 279 DO $BEGIN &kopplung := links + zaehl1 * delta_kopplung; &zeige_k(kopplung); &popula 1 mit FOR-Schleife *)  BEGIN "FOR zaehl1 := 0 TO 279 DO $BEGIN &kopplung := links + zaehl1 * delta_kopplung; &population := 0.3; &FOR zaehl2 := 1 TO 10 DO (BEGIN *setze(kopplung,population,links,rechts,oben,unten); *population := f(population,kop   (* Programmbeispiel 2.22 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " PROCEDURE berechne;  (* Versionauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30   (* Programmbeispiel 2.23 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " PROCEDURE berechne;  (* FeigenbaumDies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 **F^ND;  lor(none); (gehzu(kasten[0]); (FOR zaehl2 := 0 TO punkte DO *BEGIN ,zwisch := zaehl2 * (200 DIV punkte); ,FOR zaehl3 := 1 TO 200 DIV punkte DO .kasten[zwisch] := kasten[zwisch] + kasten[zwisch + zaehl3]; ,gehzu(kasten[zwisch]); & END; &END; "E_alt := 0.3; p_uralt := 0.3; *) (FOR zaehl2 := 1 TO unsichtbar DO *BEGIN ,population := f(population,kopplung); *END; (FOR zaehl2 := 0 TO sichtbar DO *BEGIN ,fuelle(population); ,population := f(population,kopplung); *END; (zaehl2 := 0; (penco$FOR zaehl1 := 50 DOWNTO 0 DO (* 51 Linien *) &BEGIN (FOR zaehl2 := 0 TO 205 DO *kasten[zaehl2] := 0; (kopplung := rechts - (rechts - links) * zaehl1 / 50; (zeige_kopplung(kopplung); (population := 0.3; ((* Wenn es n|tig sein sollte : *) ((* pzaehl1); &IF (zaehl3>0) THEN (drawblock(dot,0,0,0,2,zaehl3 + 1,zaehlx - 1,2 * zaehl1,0); &drawblock(dot,0,0,0,1,zaehl3,zaehlx,2 * zaehl1,15); $END; " "BEGIN " FOR zaehl2 := 0 TO 279 DO &maximalwerte[zaehl2] := 0; : boolean; $BEGIN &zaehl3 := trunc(faktor * population); &zaehlx := zaehl1 + zaehl2 * (200 DIV punkte); &zaehly := 2 * zaehl1 + zaehl3; &pencolor(none); &moveto(zaehl1,zaehl1 + zaehl1); &pencolor(white); &moveto(zaehl1 + 200,zaehl1 + nteger; $ $ $PROCEDURE fuelle( population : real); $BEGIN &zaehl3 := trunc(population * 200 / (oben - unten)); &kasten[zaehl3] := succ(kasten[zaehl3]); $END; $ $PROCEDURE gehzu( population : integer); &VAR (zaehlx,zaehly : integer; (dot *BEGIN ,setze(x_koordinate,population,0.0,279.0,unten,oben); ,population := f(population,kopplung); *END; &END; "END; " "  PROCEDURE berechne; "(* Feigenbaum-Version 4 f}r Schr{gprojektion *) " $VAR &kasten,maximalwerte : ARRAY[0..279] OF iion := 0.3; ((* Wenn es n|tig sein sollte : *) ((* p_alt := 0.3; p_uralt := 0.3; *) (FOR zaehl3 := 1 TO unsichtbar DO *BEGIN ,population := f(population,kopplung); *END; (x_koordinate := 60 * zaehl1 + zaehl2; (FOR zaehl3 := 1 TO sichtbar DO N "k_unendlich := 2.57; "epsilon := 1.039122; "FOR zaehl1 := 1 TO 3 DO (* 3 Zehnerpotenzen *) $FOR zaehl2 := 1 TO 60 DO &BEGIN (kopplung := k_unendlich - /potenz(epsilon,60 - zaehl2) / pwroften(zaehl1); (zeige_k(kopplung); (populat-Version 3 f}r logarithmische Auftragung *)  "FUNCTION potenz(basis : real;expo : integer) : real; $VAR zaehl1 : integer; (wert : real; "BEGIN $wert := 1.0; $FOR zaehl1 := 1 TO expo DO &wert := wert * basis; $potenz := wert; "END;   BEGIauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30  "  (* Programmbeispiel 2.24 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " PROCEDURE parabel_und_winkelhalb3; p_uralt := 0.3; "FOR zaehler := 1 TO unsichtbar DO $p := f(p); "REPEAT $altwert := p; $p := f(p); $setze(p,altwert,links,rechts,unten,oben); "UNTIL keypress;  END; (* von berechne *)     (* Programmbeispiel 2.26 aus * Version f}r Verhulst-Attraktor *)  BEGIN "p_alt := p_uralt; "p_uralt := p; "f := p + 0.8 * (3 * p * (1.0 - p) - p_alt * (1.0 - p_alt));  END; "   PROCEDURE berechne;  (* Version f}r Verhulst-Attraktor *)  BEGIN "p := 0.3; p_alt := 0.   (* Programmbeispiel 2.25 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " FUNCTION f(p : real) : real;  (auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 F^$read(ch); "END; (* von berechne *)   e Iteration *) "BEGIN $REPEAT &ziehe(population,population,links,rechts,unten,oben,white); &population_alt := population; &population := f(population,kopplung); &ziehe(population_alt,population,links,rechts,unten,oben,white);  UNTIL keypress; ,f(x_koordinate,kopplung),links,rechts,unten,oben,white); &x_koordinate := x_koordinate + 0.01; $UNTIL (x_koordinate > 1.5); $ziehe(population,0,links,rechts,unten,oben,none); "END; (* von parabel *) "PROCEDURE berechne; "(* Version f}r die grafischierende 0(population,kopplung,links,rechts,unten,oben : real); "BEGIN $ziehe(1.5,1.5,links,rechts,unten,oben,white); $fillscreen(black); " grafmode; $ziehe(0.0,0.0,links,rechts,unten,oben,white); $x_koordinate := 0; $REPEAT &ziehe &(x_koordinate *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " FUNCTION f(p : real) : real;  (* Version f}r modifizierten Verhulst-Attraktor *)  (* mit a, b und k experimentieren ! *)  BEGIN "p_alt := p_uralt; "p_uralt := p; "f := p + 0.5 * k * (a * p * (1.0 - p) + b * p_alt * (1.0 - p_alt));  END; "   Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 F^be festlegen *) "FOR zaehler := 1 TO unsichtbar DO f; "REPEAT $f; $setze(y,x,links,rechts,unten,oben); "UNTIL keypress;  END; (* von berechne *)   Henon-Attraktor *)  BEGIN "xalt := x; yalt := y; "x := yalt - a * xalt * xalt + 1.0; "y := b * xalt;  END;   PROCEDURE berechne;  (* Version f}r Henon-Attraktor *)  BEGIN "x := 0.0; y := 0.0; "a := 1.4; b := 0.3; (* oder andere Werte mit einga  (* Programmbeispiel 2.27 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " PROCEDURE f ;  (* Version f}r denauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 F^auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30  "  (* Programmbeispiel 2.29 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " PROCEDURE pruefen; "(* Version N fertig := zu_z_E_gehoerend ;  END; (* von pruefen *) $  ig THEN fertig := (nenner > 1.0E8) ; "IF NOT fertig THEN fertig := zu_z_A_gehoerend ; "IF NOT fertig THEN fertig := zu_z_B_gehoerend ; "IF NOT fertig THEN fertig := zu_z_C_gehoerend ; "IF NOT fertig THEN fertig := zu_z_D_gehoerend ; "IF NOT fertig THE"x := 0.8 * xalt + 0.2 * (x2 * x2 - 6.0 * x2 * y2 + y2 * y2) / nenner; "y := 0.8 * (y + (xalt * y * y2 - xalt * y * x2) / nenner); "x2 := x * x; "y2 := y * y; "nenner := x2 + y2; "fertig := (nenner < 1.0E-8); "IF NOT fertnd : boolean; "BEGIN $zu_z_E_gehoerend := ((x-xe)*(x-xe)+(y-ye)*(y-ye) <= epsquad); "END; "  BEGIN "zaehl3 := zaehl3 + 1; "xalt := x; "nenner := nenner * nenner; "nenner := nenner * nenner; zu_z_C_gehoerend : boolean; "BEGIN $zu_z_C_gehoerend := ((x-xc)*(x-xc)+(y-yc)*(y-yc) <= epsquad); "END; " "FUNCTION zu_z_D_gehoerend : boolean; "BEGIN $zu_z_D_gehoerend := ((x-xd)*(x-xd)+(y-yd)*(y-yd) <= epsquad); "END; " "FUNCTION zu_z_E_gehoere "FUNCTION zu_z_A_gehoerend : boolean; "BEGIN $zu_z_A_gehoerend := ((x-xa)*(x-xa)+(y-ya)*(y-ya) <= epsquad); "END; " "FUNCTION zu_z_B_gehoerend : boolean; "BEGIN $zu_z_B_gehoerend := ((x-xb)*(x-xb)+(y-yb)*(y-yb) <= epsquad); "END; " "FUNCTION  PROCEDURE pruefen;  (* Version fuer x^5 - 1 = 0 *)   CONST "ep2= 0.0025; "xa = 1.000000; ya = 0.0000000; "xb = 0.309017; yb = 0.9510565; "xc = -0.809017; yc = 0.5877825; "xd = -0.809017; yd = -0.5877825; "xe = 0.309017; ye = -0.9510565; hl) OR fertig; (IF NOT fertig THEN setze(zaehl1,zaehl2); ({ IF (fertig) AND (ODD(zaehl3)) THEN setze(zaehl1,zaehl2); } ({ IF ((fertig) AND (ODD(zaehl3)) AND (zaehl3 < 8)) OR NOT fertig THEN *setze(zaehl1,zaehl2); }  END;  END;   xy; "FOR ykoo := 0 TO 191 DO $FOR xkoo := 0 TO 279 DO &BEGIN (fertig := false; (zaehl3 := 0; (x := links + zaehl1 * deltax; (y := unten + zaehl2 * deltay; (x2 := x * x; (y2 := y * y; (nenner := x2 + y2; (REPEAT *pruefen; (UNTIL (zaehl3 >= anzaend ; $IF NOT fertig THEN fertig := zu_z_C_gehoerend ; "END; (* von pruefen *) $  PROCEDURE berechne;  (* Version : Julia-Menge nach dem Newton-Verfahren zu z^3 - 1 = 0 *)  BEGIN "deltax := (rechts - links) / maxx; "deltay := (oben - unten) / ma$x2 := x * x; $y2 := y * y; $nenner := x2 + y2; $fertig := (nenner < 1.0E-18); $IF NOT fertig THEN fertig := (nenner > 1.0E18) ; $IF NOT fertig THEN fertig := zu_z_A_gehoerend ; $IF NOT fertig THEN fertig := zu_z_B_gehoer "BEGIN $zaehl3 := zaehl3 + 1; $xy := x * y; $nenner := nenner * nenner; $nenner := nenner + nenner + nenner; $x := 0.666666 * x + (x2 - y2) / nenner; $y := 0.666666 * y - (xy + xy) / nenner; ad); $END; $ $FUNCTION zu_z_B_gehoerend : boolean; $BEGIN &zu_z_B_gehoerend := ((x-xb)*(x-xb)+(y-yb)*(y-yb) <= epsquad); $END; $ $FUNCTION zu_z_C_gehoerend : boolean; $BEGIN &zu_z_C_gehoerend := ((x-xc)*(x-xc)+(y-yc)*(y-yc) <= epsquad); $END; $fuer x^3 - 1 = 0 *) " $CONST &epsquad= 0.0025; &xa = 1; ya = 0; &xb = -0.500000; yb = 0.8660254; &xc = -0.500000; yc = -0.8660254; " $FUNCTION zu_z_A_gehoerend : boolean; $BEGIN &zu_z_A_gehoerend := ((x-xa)*(x-xa)+(y-ya)*(y-ya) <= epsquM1 M2 F^(zaehl3 := succ(zaehl3); &UNTIL (r < limit) OR (zaehl3 = anzahl); &IF zaehl3 < anzahl THEN setz(zaehl2, zaehl1); $END;  END;    "limit := 1E-3; "anzahl := 50; "FOR zaehl1 := ypunkte DOWNTO 0 DO $FOR zaehl2 := 0 TO xpunkte DO BEGIN &c_reell := links + zaehl2 * deltax; &c_imaginaer := unten + zaehl1 * deltay; &x := 0.0; y := 0.0; &zaehl3 := 0; &REPEAT (f; bq(x - 1.0, y, r);  END;   PROCEDURE berechne;  (* Version f}r das Newton-Verfahren zu f(z) = z^3 + (c - 1) * z - c *)  BEGIN "xpunkte := 279; ypunkte := 191; "deltax := (rechts - links) / xpunkte; "deltay := (oben - unten ) / ypunkte; _imaginaer, zwischr, zwischi); "kompmul(zwischr, zwischi, x, y, zwischr, zwischi); "kompsub(zwischr, zwischi, c_reell, c_imaginaer, zwischr, zwischi); "kompdiv(zwischr, zwischi, nr, ni, zwischr, zwischi); "kompsub(x, y, zwischr, zwischi, x, y); "kompareal; VAR absqu : real);  BEGIN "absqu := inr * inr + ini * ini;  END;   PROCEDURE f;  BEGIN "kompqad(x, y, zwischr, zwischi); "kompadd(3.0 * zwischr, 3.0 * zwischi, c_reell - 1.0, c_imaginaer, nr, ni); "kompadd(zwischr, zwischi, c_reell - 1.0, c" kompmul(in1r,in1i,in2r,-in2i,zaer,zaei); $nenner := in2r * in2r + in2i * in2i; $IF nenner = 0 THEN BEGIN $ outr := 0; &outi := 0; $END ELSE BEGIN &outr := zaer / nenner; &outi := zaei / nenner; " END; "END;   PROCEDURE kompabq(inr, ini : "BEGIN " outr := in1r * in1r - in1i * in1i; $outi := 2.0 * in1r * in1i; "END; " "PROCEDURE kompdiv(in1r,in1i,in2r,in2i : real; " VAR outr,outi : real); " VAR &zaer,zaei,nenner : real; "BEGIN "END; " "PROCEDURE kompmul(in1r,in1i,in2r,in2i : real; " VAR outr,outi : real); "BEGIN " outr := in1r * in2r - in1i * in2i; $outi := in1r * in2i + in1i * in2r; "END; " "PROCEDURE kompqad(in1r,in1i : real; 4VAR outr,outi : real);n2r,in2i : real; 4VAR outr,outi : real); "BEGIN " outr := in1r + in2r; $outi := in1i + in2i; "END;  "PROCEDURE kompsub(in1r,in1i,in2r,in2i : real; " VAR outr,outi : real); "BEGIN " outr := in1r - in2r; $outi := in1i - in2i;  "  (* Programmbeispiel 2.30 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " "PROCEDURE kompadd(in1r,in1i,iauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 F^ (* Braunschweig/Wiesbaden 1986 *) "  PROCEDURE sprung;  BEGIN "IF screenbit(zaehl1,zaehl2) THEN pencolor(white) ELSE pencolor(none); "zaehl1 := zaehl1 + 10; "moveto(zaehl1,zaehl2); "pencolor(none); "read(ch);  END;     hl2); "UNTIL (zaehl2 = ypunkte) AND (zaehl1 = xpunkte);  END;  "   (* Programmbeispiel 2.32 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *) = 0; (zaehl2 := succ(zaehl2); &END; $x := links + zaehl1 * deltax; $y := unten + zaehl2 * deltay; $xhoch2 := x * x; $yhoch2 := y * y; $fertig := false; $zaehl3 := 0; $REPEAT &f $UNTIL fertig; $IF zaehl3 = anzahl THEN setze(zaehl1,zae)  BEGIN "deltax := (rechts-links)/xpunkte; "deltay := (oben-unten)/ypunkte; "zaehl1 := -1; "zaehl2 := 0 ; "REPEAT $zaehl1 := succ(zaehl1); ${ IF keypress THEN sprung ELSE zaehl1 := succ(zaehl1); } $IF (zaehl1 > xpunkte) THEN &BEGIN (zaehl1 :&fertig := false; &zaehl3 := 0; &REPEAT (f &UNTIL fertig; &IF zaehl3 = anzahl THEN setze(zaehl2,zaehl1); $END;  END; "  PROCEDURE berechne;  (* Version f}r zn+1 = zn2 - c *)  (* Julia - Menge *)  (* hier mit REPEAT-Schleife *punkte; "FOR zaehl1 := 0 TO ypunkte DO $FOR zaehl2 := 0 TO xpunkte DO BEGIN &c_reell := links + zaehl2 * deltax; &c_imaginaer := unten + zaehl1 * deltay; &x := 0.0; &y := 0.0; &xhoch2 := x * x; &yhoch2 := y * y; *  PROCEDURE berechne;  (* Version f}r zn+1 = zn^2 - c *)  (* Mandelbrot - Menge, Apfelm{nnchen *)  (* hier mit 2 verschachtelten FOR-Schleifen *)  BEGIN "deltax := (rechts - links) / xpunkte; "deltay := (oben - unten ) / y = zn^2 - c *)  BEGIN "zaehl3 := succ(zaehl3); "y := 2.0 * x * y - c_imaginaer; "x := xhoch2 - yhoch2 - c_reell; "xhoch2 := x * x; "yhoch2 := y * y; "absqu := xhoch2 + yhoch2; "fertig := (absqu > grenze1) OR (zaehl3 = anzahl ) ;  END;   (* Programmbeispiel 2.31 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " PROCEDURE f;  (* Version f}r zn+1auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM F^ (* Braunschweig/Wiesbaden 1986 *) " " "PROCEDURE dividiere ( zaehler, nenner : lang; VAR ergebnis : lang ); "BEGIN $ergebnis := ( zaehler * pseudo_1 ) DIV nenner; "END; "   ; $UNTIL (pseudo = 0) OR (lfaktor = 1); $rueck := zw; "END;   (* Programmbeispiel 2.36 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *) : lang; "BEGIN $lfaktor := pseudo_1; $zw := 0; $rfaktor := 0.1; $REPEAT &lfaktor := lfaktor DIV 10; &stelle := trunc(pseudo DIV lfaktor); &zw := zw + stelle * rfaktor; &pseudo := pseudo - stelle * lfaktor; &rfaktor := rfaktor / 10.0 pseudo + trunc(reell) * faktor; &faktor := faktor DIV 10; &reell := 10 * (reell - trunc(reell)); $UNTIL (reell <= 0.0) OR (faktor = 1); "END; " "FUNCTION rueck(pseudo : lang) : real; $VAR &rfaktor, zw : real; &stelle : integer; &lfaktor  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " "PROCEDURE umwandlung(reell : real; VAR pseudo : lang); $VAR &faktor : lang; "BEGIN $faktor := pseudo_1; $pseudo := 0; $REPEAT &pseudo :=ang; "BEGIN $eins_minus_p := 10*pseudo_1 - pop; $mult (pop,eins_minus_p,zwisch); $mult (zwisch,kop,pop) "END;  "  (* Programmbeispiel 2.35 aus *)  (* Becker / Doerfler *) *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " "PROCEDURE f (VAR pop,kop : lang ); $VAR &zwisch,eins_minus_p : lgrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " "PROCEDURE mult(mkand,mkator : lang; VAR ergebnis : lang); "BEGIN $ergebnis := (mkand * mkator) DIV pseudo_1; "END;   "  (* Programmbeispiel 2.34 aus"TYPE $lang = integer[36];   "CONST $pseudo_1 = 1000000000000000000; $(* = 10^18, bitte beim Eintippen nicht verzaehlen *)   (* Programmbeispiel 2.33 aus *)  (* Becker / Doerfler *)  (* Computerauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M M1 M2 O^I+ *) $END; $ "BEGIN $textmode; $REPEAT &writeln; &writeln('Name der Datei ?'); &readln(filename); &FOR zaehl1 := 1 TO length(filename) DO (IF (filename[zaehl1] IN ['a'..'z']) *THEN filename[zaehl1] := chr(ord(filename[zaehl1]-32); &IF pos('.FVersion 2 *)  VAR &f : file; &inout,zaehl1 : integer; &filename : string; " $FUNCTION vorhanden (filename : string) : boolean; $BEGIN " close(f); &(*$I- *) &reset(f,filename); &vorhanden := ioresult = 0; &close(f); $ (*$ "  (* Programmbeispiel 2.38 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " "PROCEDURE bildlesen; (* auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M M1 M2 O^cat(filename,'.FOTO'); $bild.adresse := 8192; $rewrite(f,filename); $inout := blockwrite(f,bild.zeiger^,16); $close(f,lock); $IF inout <> 16 &THEN writeln('Schreiben hat nicht geklappt !!'); "END;   de; $writeln; $writeln('Name der Datei ?'); $readln(filename); $FOR zaehl1 := 1 TO length(filename) DO &IF (filename[zaehl1] IN ['a'..'z']) (THEN filename[zaehl1] := chr(ord(filename[zaehl1]-32); $IF pos('.FOTO',filename) = 0 &THEN filename := conean OF .true : (adresse : integer); .false : (zeiger : ^integer); ,END;  "VAR $bild : tbild;  PROCEDURE bildspeichern; (* Version 1 *)  VAR &f : file; &inout,zaehl1 : integer; &filename : string; "BEGIN $textmo$  (* Programmbeispiel 2.37 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " "TYPE $tbild = RECORD CASE boolauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM OTO',filename) = 0 (THEN filename := concat(filename,'.FOTO'); $UNTIL vorhanden(filename); $grafmode; $bild.adresse := 8192; $rewrite(f,filename); $inout := blockread(f,bild.zeiger^,16); $close(f,lock); "END;    M M1 M2 uuO^Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M M1 M2 O^drawblock(bildfeld,36,0,0,280,192,0,0,modus); (END &ELSE (BEGIN *writeln('Lesefehler !! Abbruch !'); (END; "END;   ') = 0 (THEN filename := concat(filename,'.PHOTO'); $UNTIL vorhanden(filename); $rewrite(f,filename); $inout := blockread(f,bildfeld,14); $close(f,lock); " IF inout = 14 &THEN (BEGIN *write('Bitte Modus 0..15 waehlen > '); *readln(modus); *$ "BEGIN $textmode; $REPEAT &writeln; &writeln('Name der Datei ?'); &readln(filename); &FOR zaehl1 := 1 TO length(filename) DO (IF (filename[zaehl1] IN ['a'..'z']) *THEN filename[zaehl1] := chr(ord(filename[zaehl1]-32); &IF pos(filename,'.PHOTO VAR &f : file; &inout,zaehl1 : integer; &filename : string; " $FUNCTION vorhanden (filename : string) : boolean; $BEGIN " close(f); &(*$I- *) &reset(f,filename); &vorhanden := ioresult = 0; &close(f); $ (*$I+ *) $END; cat(filename,'.PHOTO'); $invdraw(bildfeld); $rewrite(f,filename); $inout := blockwrite(f,bildfeld,14); $close(f,lock); $IF inout <> 14 &THEN writeln('Schreiben hat nicht geklappt !!'); "END;   "PROCEDURE bildlesen; (* Version 2 *) e; $writeln; $writeln('Name der Datei ?'); $readln(filename); $FOR zaehl1 := 1 TO length(filename) DO &IF (filename[zaehl1] IN ['a'..'z']) (THEN filename[zaehl1] := chr(ord(filename[zaehl1]-32); $IF pos('.PHOTO',filename) = 0 &THEN filename := conRRAY[0..287,0..199]; "VAR $bildfeld : tfeld; " "PROCEDURE invdraw (bildfeld : tfeld); "EXTERNAL;  "PROCEDURE bildspeichern; (* Version 2 *)  VAR &f : file; &inout,zaehl1 : integer; &filename : string; "BEGIN $textmod  (* Programmbeispiel 2.39 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " " "TYPE $tfeld : PACKED Aauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 (*$S+ *)  PROGRAM slideshow; #  (* Programmbeispiel 2.40 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " "US Ende mit '); $write(' -----> '); readln(verzgr); "END; (* von Eingabe *) "  BEGIN "eingabe; "holen;  END. $writeln('Alle Files vom Typ ''.FOTO'' und ''.PHOTO'''); $writeln('werden nacheinander gezeigt.'); $writeln; $writeln('Bitte die Verzoegerung eingeben, dabei bedeutet'); $writeln('''0'', dass der Bildwechsel auf Tastendruck erfolgt.'); $writeln(' ucc(zaehl1); &END; &zaehl1 := 0; $UNTIL (ch = 'Q') OR (ch = 'q'); " textmode; "END; (* von holen *) " "  PROCEDURE eingabe; "BEGIN $page(output); $writeln;writeln; writeln; $writeln('*** SLIDESHOW ***'); $writeln; writeln; writeln; l3) AND (ch <> 'Q') AND (ch <> 'q') DO BEGIN (fotofile := fnamen[zaehl1]; (hol(fotofile); (IF (verzgr = 0) THEN read(ch) ELSE FOR zaehl2 := 1 TO verzgr * 1000 DO; (IF keypress THEN read(ch); (IF (ch = 'Q') OR (ch = 'q') THEN exit(holen); (zaehl1 := sawblock(bildfeld,35,0,0,280,192,0,0,14); *drawblock(bildfeld,35,0,0,280,192,0,0,10); (END; &END; $END; $ " "BEGIN (* von holen *) $inhalt; $IF (zaehl3 = 0) THEN exit(holen); $grafmode; $zaehl1 := 0; $ch := ';'; $REPEAT &WHILE (zaehl1 < zaeh(bild.adresse := page1; (reset(f,bildname); (io:=blockread(f,bild.zeiger^,16); (close(f,lock); $ END ELSE IF pos('.PHOTO',bildname) <> 0 THEN BEGIN & reset(f,bildname); (io := blockread(f,bildfeld,14); (close(f,lock); (IF io = 14 THEN BEGIN *drfotofile) >0) OR (pos('.FOTO',fotofile) >0) THEN BEGIN *fnamen[zaehl3] := concat('#4:',fotofile); *zaehl3 := succ(zaehl3); (END; &END; $END; $ $PROCEDURE hol(bildname:string); $BEGIN &IF pos('.FOTO',bildname) <> 0 THEN BEGIN ) >0) THEN BEGIN *fnamen[zaehl3] := concat('#5:',fotofile); *zaehl3 := succ(zaehl3); (END; &END; &unitread(4,inh,2048,2,0); &FOR zaehl4 := 1 TO inh [0].bezeichnung.filezahl DO BEGIN (fotofile := inh [zaehl4].bezeichnung.filename; (IF (pos('.PHOTO',PROCEDURE holen;  $PROCEDURE inhalt; $BEGIN &unitread(5,inh,2048,2,0); &zaehl3 := 0; &FOR zaehl4 := 1 TO inh [0].bezeichnung.filezahl DO BEGIN (fotofile := inh [zaehl4].bezeichnung.filename; (IF (pos('.PHOTO',fotofile) >0) OR (pos('.FOTO',fotofile$ch : char; $fotofile : string; $inh : ARRAY[0..78] OF eintrag; $fnamen : ARRAY[0..34] OF string; $f : FILE; $bild : tbild; $bildfeld : tfeld; $ "$tbild = RECORD CASE boolean OF 0true : (adresse : integer); 0false : (zeiger : ^integer) .END; ! $tfeld = PACKED ARRAY [0..287,0..199] OF boolean; % "VAR $verzgr, $zaehl1,zaehl2,zaehl3, $zaehl4,io,parameter : integer; : (vol, code, text, data); 0bezeichnung : RECORD CASE integer OF A1 : (filename : string [15]); A2 : (diskname: string [7]; Fdummi,filezahl,blockzahl : integer; Fdiskdatum : date); ?END; 0bytezahl : integer; 0filedatum : date .END; " ES $applestuff,turtlegrafics; $ "CONST $page1 = 8192; $page2 = 16384; $ "TYPE $date = PACKED RECORD -monat : 1..12; -tag : 1..31; -jahr : 1..99 +END; + $eintrag = RECORD 0dieser : integer; 0naechster : integer; 0typ M M1 M2 RO^"textmode; writeln; writeln; "write('Ausgabe : D)rucken oder S)peichern ?'); "REPEAT $read(ch) "UNTIL ch IN ['d','D','s','S']; "IF ch IN ['d','D'] $THEN rausdamit $ELSE bildspeichern;  END; (* von ausgabe *)  *writeln(p,esc,'f'); *close(p); (END; $END ELSE BEGIN (close(p); (rewrite(p,'PRINTER:'); (writeln(p,esc,'L','0','0','0'); (close(p); &END; $grafmode; $hardcopy(parameter); "END; (* von rausdamit *) # "  PROCEDURE ausgabe;  BEGIN rite(p,esc,'n'); (writeln(p,esc,'L',s1,s2,s3); (close(p); &END ELSE (IF (ch='D') or (ch='d') THEN BEGIN *close(p); *rewrite(p,'PRINTER:'); *write(p,esc,'n'); *write(p,esc,'L','0','3','5'); *write(p,esc,'r'); *FOR zaehl := 1 TO 18 DO writeln(p); teln; &IF (ch='L') OR (ch='l') THEN BEGIN (writeln;write('0..36 --> ');readln(margin); (str(margin,st); (st := copy(concat('00',st),length(st),3); (s1 := copy(st,1,1); s2 := copy(st,2,1); (s3 := copy(st,3,1); (close(p); (rewrite(p,'PRINTER:'); (w$write('bitte waehlen > '); $REPEAT &readln(parameter); $UNTIL (parameter < 32); $IF (parameter < 0) THEN exit(rausdamit); $IF NOT odd(parameter) THEN BEGIN $ writeln; &writeln; &write('L(inken Rand einstellen, D(anebendrucken ?'); &read(ch);wri writeln; $writeln(' +4 : invers ');  writeln; $writeln(' +8 : Grafik-Seite 2'); $writeln; $writeln(' +16 : verstaerkt '); $writeln; $writeln(' < 0 : nicht drucken '); $writeln; r(27); $textmode;  writeln;  writeln('Es gibt 32 Arten von Hardcopy');  writeln; $writeln(' 0 : Normal klein ');  writeln; $writeln(' +1 : doppelt breit ');  writeln; $writeln(' +2 : dopelt hoch ');  ch *) " " "PROCEDURE hardcopy(par : integer); "EXTERNAL; " "PROCEDURE rausdamit; $VAR &esc : char; &margin,zaehl,i : integer; " p : text; &st,s1,s2,s3 : string[3]; "BEGIN $margin := 0; $esc := ch  (* Programmbeispiel 2.41 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) "  (* etwas ausf}hrlicher als im Buauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM  MASERN Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 F^#"BEGIN $readln; $textmode; "END; (* von ausgabe *) "  BEGIN (* Hauptprogramm *) "eingabe; "berechne; "ausgabe;  END. (* Hauptprogramm *)     ng := links + bereich * delta_kopplung; (population := 0.3; (FOR zaehler := 1 TO 10 DO *BEGIN ,setze(kopplung,population,links,rechts,oben,unten); ,population := f(population,kopplung); *END; &END; "END; (* von berechne *) " "PROCEDURE ausgabe; $links := 0; rechts := 3; $oben := 1.5; unten := 0; $delta_kopplung := (rechts-links)/xschirm; $initturtle; "END; (* von eingabe *) " "PROCEDURE berechne; " VAR bereich, zaehler : integer; "BEGIN $FOR bereich := 0 TO xschirm DO &BEGIN (kopplu)); $pencolor(white); $move(0) "END; (* von setze *)  "PROCEDURE eingabe; "BEGIN $writeln('Darstellung des Masern-Problems'); writeln; $writeln('Start mit '); $writeln('Wenn das Bild fertig ist, '); $readln; (1 - population) "END; (* von f *) " "PROCEDURE setze ( xkoo, ykoo, links, rechts, oben, unten : real); "BEGIN $pencolor(none); $moveto(round( xschirm * ( xkoo - links ) / ( rechts - links )) ), round( yschirm * ( ykoo - unten ) / ( oben - unten )   ?  ȡ^ ٥> ȡ1   fB x&,F " ǿ LDarstellung des Masern-ProblemsצStart mit צ"Wenn das Bild fertig ist,    ?  ȡ^ ٥> ȡ1   fB x " ǿ LDarstellung des Masern-ProblemsצStart mit צ"Wenn das Bild fertig ist, B0auf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 51    PROGRAM masernwerte;  (* Programmbeispiel 2.1 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) "VAR $poe Formel heisst :'); $writeln $('f(population) = population + kopplung * population * ( 1 - population)'); $writeln; $write('Anfangswert population (0..1) > '); $readln(population); $write('Parameter kopplung (0..3) > '); $readln(kopplung); "pulation,kopplung : real; $zaehler : integer;  "FUNCTION f (p, k : real) : real; "BEGIN $IF (abs(p) < 1.0E-15) THEN &f := p $ELSE &f := p + k * p * ( 1 - p ); "END; (* von f *) " "PROCEDURE eingabe; "BEGIN $writeln; $writeln('Di   PROGRAM masernwerte;  (* Programmbeispiel 2.2 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) "VAR $poauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 51 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 F^# BEGIN (* Hauptprogramm *) "eingabe; "zaehler := 0; "REPEAT $zaehler := zaehler + 1; $berechne; $ausgabe; "UNTIL (zaehler >= 20) OR (abs(population) >= 30);  END. (* Hauptprogramm *)    := population + kopplung * population * ( 1 - population ) "END; (* von berechne *) " "PROCEDURE ausgabe; "BEGIN $writeln;writeln('Nach ',zaehler,' Iterationen '); $writeln('hat population den Wert ',population:9:4); "END; (* von ausgabe *) " population (0..1) > '); $readln(population); $write('Parameter kopplung (0..3) > '); $readln(kopplung); "END; (* von eingabe *) " "PROCEDURE berechne; "BEGIN $IF (abs(population) < 1E-15) THEN &population := population $ELSE &populationpulation,kopplung : real; $zaehler : integer;  "PROCEDURE eingabe; "BEGIN $writeln; $writeln('Die Formel heisst :'); $writeln $('f(population) = population + kopplung * population * ( 1 - population)'); $writeln; $write('Anfangswert END; (* von eingabe *) " "PROCEDURE berechne; "BEGIN $population := f(population,kopplung); "END; (* von berechne *) " "PROCEDURE ausgabe; "BEGIN $writeln;writeln('Nach ',zaehler,' Iterationen '); $writeln('hat population den Wert ',population:9:4); "END; (* von ausgabe *) "  BEGIN (* Hauptprogramm *) "eingabe; "zaehler := 0; "REPEAT $zaehler := zaehler + 1; $berechne; $ausgabe; "UNTIL (zaehler >= 20) OR (abs(population) >= 30);  END. (population := f(population,kopplung); &UNTIL keypress; &read(ch); $END;  END;     tion := 0.3; &(* Wenn es n|tig sein sollte : *) &(* p_alt := 0.3; p_uralt := 0.3; *) &FOR zaehl2 := 1 TO unsichtbar DO (BEGIN *population := f(population,kopplung); (END; &REPEAT (setze(kopplung,population,links,rechts,unten,oben); plung); (END; $END;  END; (* von berechne *)    PROCEDURE berechne;  (* Version 2 mit REPEAT...UNTIL keypress - Schleife *)  BEGIN "FOR zaehl1 := 0 TO 279 DO $BEGIN &kopplung := links + zaehl1 * delta_kopplung; &zeige_k(kopplung); &popula 1 mit FOR-Schleife *)  BEGIN "FOR zaehl1 := 0 TO 279 DO $BEGIN &kopplung := links + zaehl1 * delta_kopplung; &population := 0.3; &FOR zaehl2 := 1 TO 10 DO (BEGIN *setze(kopplung,population,links,rechts,oben,unten); *population := f(population,kop   (* Programmbeispiel 2.22 aus *)  (* Becker / Doerfler *)  (* Computergrafische Experimente mit Pascal *)  (* Braunschweig/Wiesbaden 1986 *) " PROCEDURE berechne;  (* Versionauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 51 Dies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM M1 M2 RRF^# (* Hauptprogramm *)    $write('bitte waehlen > '); $REPEAT &readln(parameter); $UNTIL (parameter < 32); $IF (parameter < 0) THEN exit(rausdamit); $IF NOT odd(parameter) THEN BEGIN $ writeln; &writeln; &write('L(inken Rand einstellen, D(anebendrucken ?'); &read(ch);wriDies Programm ist aus dem Buch : Becker/Doerfler : Computergrafische Experimente mit Pascal, Vieweg 1986 ISBN 3-528-04461-6. Viel Spass damit ! Und eine Bitte : Wenn Sie die Diskette schwarz kopiert haben, ueberweisen Sie Benutzungsgeb}hr von 30,00 DM "textmode; writeln; writeln; "write('Ausgabe : D)rucken oder S)peichern ?'); "REPEAT $read(ch) "UNTIL ch IN ['d','D','s','S']; "IF ch IN ['d','D'] $THEN rausdamit $ELSE bildspeichern;  END; (* von ausgabe *)  *writeln(p,esc,'f'); *close(p); (END; $END ELSE BEGIN (close(p); (rewrite(p,'PRINTER:'); (writeln(p,esc,'L','0','0','0'); (close(p); &END; $grafmode; $hardcopy(parameter); "END; (* von rausdamit *) # "  PROCEDURE ausgabe;  BEGIN rite(p,esc,'n'); (writeln(p,esc,'L',s1,s2,s3); (close(p); &END ELSE (IF (ch='D') or (ch='d') THEN BEGIN *close(p); *rewrite(p,'PRINTER:'); *write(p,esc,'n'); *write(p,esc,'L','0','3','5'); *write(p,esc,'r'); *FOR index := 1 TO 18 DO writeln(p); teln; &IF (ch='L') OR (ch='l') THEN BEGIN (writeln;write('0..36 --> ');readln(margin); (str(margin,st); (st := copy(concat('00',st),length(st),3); (s1 := copy(st,1,1); s2 := copy(st,2,1); (s3 := copy(st,3,1); (close(p); (rewrite(p,'PRINTER:'); (w$write('bitte waehlen > '); $REPEAT &readln(parameter); $UNTIL (parameter < 32); $IF (parameter < 0) THEN exit(rausdamit); $IF NOT odd(parameter) THEN BEGIN $ writeln; &writeln; &write('L(inken Rand einstellen, D(anebendrucken ?'); &read(ch);wri"textmode; writeln; writeln; "write('Ausgabe : D)rucken oder S)peichern ?'); "REPEAT $read(ch) "UNTIL ch IN ['d','D','s','S']; "IF ch IN ['d','D'] $THEN rausdamit $ELSE bildspeichern;  END; (* von ausgabe *)  *writeln(p,esc,'f'); *close(p); (END; $END ELSE BEGIN (close(p); (rewrite(p,'PRINTER:'); (writeln(p,esc,'L','0','0','0'); (close(p); &END; $grafmode; $hardcopy(parameter); "END; (* von rausdamit *) # "  PROCEDURE ausgabe;  BEGIN rite(p,esc,'n'); (writeln(p,esc,'L',s1,s2,s3); (close(p); &END ELSE (IF (ch='D') or (ch='d') THEN BEGIN *close(p); *rewrite(p,'PRINTER:'); *write(p,esc,'n'); *write(p,esc,'L','0','3','5'); *write(p,esc,'r'); *FOR index := 1 TO 18 DO writeln(p); teln; &IF (ch='L') OR (ch='l') THEN BEGIN (writeln;write('0..36 --> ');readln(margin); (str(margin,st); (st := copy(concat('00',st),length(st),3); (s1 := copy(st,1,1); s2 := copy(st,2,1); (s3 := copy(st,3,1); (close(p); (rewrite(p,'PRINTER:'); (wauf das Konto 4812 63-200 beim Postgiroamt Hamburg (BLZ 200 100 20) K.-H. Becker, M. Doerfler, Sonderkonto, Ritterstr. 17 2800 Bremen 1. Wenn dies nicht gewuenscht ist, loeschen Sie bitte die Programme wieder. 30